home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / input.zip / INPUTUN.PAS < prev   
Pascal/Delphi Source File  |  1993-01-04  |  7KB  |  261 lines
  1. Unit InputUn;
  2.  
  3. { This is a small unit with crash proof user input routines and some
  4.   string formating functions. Compile the DemoInput program for more
  5.   information on how to use these functions.
  6.  
  7.    Robert Mashlan [71160,3067]  3/11/89 }
  8.  
  9. Interface
  10.  
  11. Uses Crt;
  12.  
  13. const
  14.    DefaultSet = [' '..'}'];
  15.  
  16. Var
  17.    InverseOn    : boolean;
  18.    UpcaseOn     : boolean;
  19.    ValidCharSet : set of char;
  20.  
  21. Procedure Inverse;
  22. Procedure UnderLine;
  23. Procedure Normal;
  24. Procedure Goback;
  25. Function ReadString( Prompt : string; Width : byte; var Escape : boolean ) : string;
  26. Function ReadNum( Prompt : real; Width : byte; var Escape : boolean ) : real;
  27. Function ReadInt( Prompt : longint; Width : byte; var Escape : boolean ) : longint;
  28. Function Left( AnyString : string; Width : byte ) : string;
  29. Function Center( AnyString : string; Width : byte ) : string;
  30.  
  31. Implementation
  32.  
  33. const
  34.    esc = #27;
  35.  
  36. Procedure Inverse;
  37. begin
  38.    textbackground(white);
  39.    textcolor(black);
  40. end;
  41.  
  42. Procedure UnderLine;
  43. begin
  44.    textbackground(white);
  45.    textcolor(blue);
  46. end;
  47.  
  48. Procedure Normal;
  49. begin
  50.    textbackground(black);
  51.    textcolor(white);
  52. end;
  53.  
  54.  
  55. Procedure Goback;
  56. begin
  57.    GotoXY(WhereX,WhereY-1);
  58.    ClrEol;
  59. end;
  60.  
  61. Function Left( AnyString : string; Width : byte ) : string;
  62. var
  63.    len  : byte absolute AnyString;
  64.    loop : byte;
  65. begin
  66.    while length( AnyString ) < Width do
  67.       AnyString:=AnyString+' ';
  68.    len:=Width;      { truncate AnyString if Needed }
  69.    Left:=AnyString;
  70. end;
  71.  
  72. Function Center( AnyString : string; Width : byte ) : string;
  73. begin
  74.    repeat
  75.       if length( AnyString ) < Width
  76.          then AnyString:=AnyString+' ';
  77.       if length( AnyString ) < Width
  78.          then AnyString:=' '+AnyString;
  79.    until length( AnyString ) >= Width;
  80.    Center:=AnyString;
  81. end;
  82.  
  83.  
  84. Function ReadString( Prompt : string; Width : byte; var Escape : boolean ) : string;
  85. var
  86.    NewString    : string;
  87.    InKey,InKey2 : char;
  88.    Start        : byte;
  89.    index        : integer;
  90.    InsertMode   : boolean;
  91.  
  92.    Procedure Display;
  93.    begin
  94.       GotoXY(Start,WhereY);
  95.       if InverseOn
  96.          then Inverse;
  97.       write(left(NewString,Width));
  98.       if InverseOn
  99.          then Normal;
  100.       GotoXY(Start+index,WhereY);
  101.    end;
  102.  
  103.    Procedure StripSpaces( var AnyString : string );
  104.    { decrease length of AnyString until a character until a char other than a space is found }
  105.    begin
  106.       while AnyString[ ord(AnyString[0]) ]=' ' do
  107.          dec(AnyString[0]);
  108.    end; { Procedure }
  109.  
  110.  
  111.  
  112. begin
  113.    InsertMode:=false;
  114.    Start:=WhereX;
  115.    index:=0;
  116.    NewString:=Prompt;
  117.    Display;
  118.    index:=1;
  119.    if UpCaseOn
  120.       then Inkey:=UpCase(ReadKey)
  121.       else InKey:=ReadKey;
  122.    if InKey=#0
  123.       then begin
  124.          InKey2:=ReadKey;
  125.          if InKey2 in [#77,#82]
  126.             then NewString:=Prompt
  127.             else NewString:='';
  128.          if Inkey2=#82
  129.             then begin
  130.                InsertMode:=true;
  131.                index:=0;
  132.             end;
  133.       end { then }
  134.       else if InKey in ValidCharSet
  135.          then NewString:=InKey
  136.          else begin
  137.             NewString:='';
  138.             index:=0;
  139.          end;
  140.    if InKey=esc
  141.       then begin
  142.          ReadString:=Prompt;
  143.          Escape:=true;
  144.          ValidCharSet:=defaultSet;
  145.          exit;
  146.       end;
  147.    if InKey=#13
  148.       then begin
  149.          Escape:=false;
  150.          ReadString:=Prompt;
  151.          ValidCharSet:=DefaultSet;
  152.          exit;
  153.       end;
  154.    Display;
  155.    repeat
  156.      if UpCaseOn
  157.         then Inkey:=Upcase(readkey)
  158.         else InKey:=ReadKey;
  159.      if (InKey in ValidCharSet)
  160.        then begin
  161.            if not InsertMode
  162.               then Delete(NewString,index+1,1);
  163.            insert(InKey,NewString,index+1);
  164.            if index<> Width then inc(index)
  165.         end;
  166.      if (length(NewString)<>0) and (InKey=#8)  { backspace }
  167.         then begin
  168.            Delete(NewString,index,1);
  169.            if index<>0
  170.               then dec(index);
  171.         end;
  172.      if InKey=#0
  173.         then begin
  174.            InKey:=ReadKey;
  175.            case InKey of
  176.           #77 : if (index<>length(NewString)) and (' ' in ValidCharSet)
  177.                      then inc(index)
  178.                      else if (index+1<>Width) and (' ' in ValidCharSet)
  179.                         then begin
  180.                            NewString:=NewString+' ';
  181.                            inc(index);
  182.                         end;
  183.               #75 : if index<>0
  184.                        then if length(NewString)+1<>index
  185.                           then dec(index)
  186.                           else if NewString[index]=' '
  187.                              then begin
  188.                                 NewString[0]:=succ(NewString[0]);
  189.                                 dec(index);
  190.                              end
  191.                              else dec(index);
  192.               #83 : if length(NewString)>0 then Delete(NewString,index+1,1);
  193.               #82 : if InsertMode
  194.                        then InsertMode:=false
  195.                        else InsertMode:=true;
  196.            end; { case }
  197.         end; { then }
  198.      if Length(NewString)>width then dec( NewString[0] );
  199.      if index >= width then dec(index);
  200.      Display;
  201.    until (InKey=#13) or (InKey=esc);
  202.    ValidCharSet:=DefaultSet;
  203.    if not ( (InKey=esc) or (length(NewString)=0))
  204.       then begin
  205.          StripSpaces(NewString);
  206.          ReadString:=NewString
  207.       end
  208.       else ReadString:=Prompt;
  209.    if InKey=esc
  210.       then Escape:=true
  211.       else Escape:=false;
  212.  
  213. end; { Procedure }
  214.  
  215. Function ReadNum( Prompt : real; Width : byte; var Escape : boolean ) : real;
  216. var
  217.    NewString : string;
  218.    code      : integer;
  219.    OldNum    : real;
  220.    Start     : byte;
  221. begin
  222.    OldNum:=Prompt;
  223.    Start:=WhereX;
  224.    repeat
  225.       GotoXY(Start,WhereY);
  226.       str( Prompt:0:2, NewString );
  227.       ValidCharSet:=['0'..'9','.','-',' '];
  228.       NewString:=ReadString( NewString, Width, Escape );
  229.       val(NewString,Prompt,code);
  230.    until Escape or (code=0);
  231.    if Escape or (code<>0)
  232.       then ReadNum:=OldNum
  233.       else ReadNum:=Prompt;
  234. end;
  235.  
  236. Function ReadInt( Prompt : longint; Width : byte; var Escape : boolean ) : longint;
  237. var
  238.    NewString : string;
  239.    code      : integer;
  240.    OldNum    : longint;
  241.    Start     : byte;
  242. begin
  243.    OldNum:=Prompt;
  244.    Start:=WhereX;
  245.    repeat
  246.       GotoXY(Start,WhereY);
  247.       str( Prompt, NewString );
  248.       ValidCharSet:=['0'..'9','-',' '];
  249.       NewString:=ReadString( NewString, Width, Escape );
  250.       val(NewString,Prompt,code);
  251.    until Escape or (code=0);
  252.    if Escape
  253.       then ReadInt:=OldNum
  254.       else ReadInt:=Prompt;
  255. end;
  256.  
  257. begin
  258.    InverseOn:=true;
  259.    UpcaseOn:=false;
  260.    ValidCharSet:=DefaultSet;
  261. end.